home *** CD-ROM | disk | FTP | other *** search
/ MacWorld: Complete Mac Interactive / Macworld Complete Mac Interactive CD)(1994).iso / The Best of BMUG / Utilities / Text and Speech / Alpha.5.76 / Tcl / UserCode / sortLines.tcl~ < prev    next >
Text File  |  1994-03-08  |  2KB  |  93 lines
  1. # FILE: sortLines.tcl
  2. #
  3. # LAST UPDATE: 1/26/93 4:53:48 PM
  4. #
  5. # This version of sortLines has the option of ignoring blanks/whitespace (-b)
  6. # and case-insensitive sorting (-i):
  7. #     sortLines [-b] [-i]
  8.  
  9. # COPYRIGHT:
  10. #
  11. #    Copyright © 1992,1993 by David C. Black All rights reserved.
  12. #    Portions copyright © 1990, 1991, 1992 Pete Keleher. All Rights Reserved.
  13. #
  14. #    Redistribution and use in source and binary forms are permitted
  15. #    provided that the above copyright notice and this paragraph are
  16. #    duplicated in all such forms and that any documentation,
  17. #    advertising materials, and other materials related to such
  18. #    distribution and use acknowledge that the software was developed
  19. #    by David C. Black.
  20. #
  21. #    THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
  22. #    IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
  23. #    WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  24. #
  25. ################################################################################
  26.  
  27. # AUTHOR
  28. #
  29. #    David C. Black
  30. #    GEnie:    D.C.Black
  31. #    Internet: black@mpd.tandem.com (preferred)
  32. #    USnail:   6217 John Chisum Lane, Austin, TX 78749
  33. #
  34. ################################################################################
  35.  
  36. proc sortLines {args} {
  37.     set b_flag [lsearch $args "-b"]
  38.     if {$b_flag != -1} {
  39.         set args [lreplace $args $b_flag $b_flag]
  40.     }
  41.     incr b_flag
  42.  
  43.     set i_flag [lsearch $args "-i"]
  44.     if {$i_flag != -1} {
  45.         set args [lreplace $args $i_flag $i_flag]
  46.     }
  47.     incr i_flag
  48.     
  49.     set start [getPos]
  50.     set end  [selEnd]
  51.     if {$start == $end} {
  52.         alertnote "You must highlight the section you wish to sort."
  53.         return
  54.     }
  55.     if {[lookAt [expr $end-1]] != "\r"} {
  56.         alertnote "The selection must consist only of complete lines."
  57.         return
  58.     }
  59.     set text [split [getText $start [expr {$end-1}]] "\r"]
  60.     if {$b_flag > 0 || $i_flag > 0} {
  61.         foreach line $text {
  62.             if {$i_flag > 0} {
  63.                 set key [string tolower $line]
  64.             } else {
  65.                 set key $line
  66.             }
  67.             if {$b_flag > 0} {
  68.                 regsub -all "\[ \t\]+" $key " " key
  69.             }
  70.             set orig($key) $line
  71.             lappend list $key
  72.         }
  73.         #endforeach
  74.         unset text
  75.         foreach key [lsort $list] {
  76.             lappend text $orig($key)
  77.         }
  78.         #endforeach
  79.     } else {
  80.         set text [lsort $text]
  81.     }
  82.     set text [join $text "\r"]
  83.     replaceText $start [expr {$end-1}] $text
  84.     select $start $end
  85. }
  86.  
  87. # Test case:
  88. #
  89. # a  black
  90. # a black cat
  91. # A  black dog
  92.  
  93.